{
  Copyright 2012 Sergey Ostanin

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
}

unit QuestionViewer;

interface

uses
  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
  Shape, ItImport, ItParser, TestUiUtils, base64, ItCommon, TestCore,
  VisualUtils, MiscUtils, QuestionScreens;

type
  TQuestionViewerFrame = class;

  TQuestionViewerFrame = class(TShapeFrame)
    lblError: TLabel;
  private
    FVersion: Int64;
    FSourceQuestion: TQuestion;
    FProducedQuestion: TQuestion;
    FScreen: TFrame;
    FOnEvaluateAnswer: TNotifyEvent;
    FPartRight: Single;
    FEvaluationFailed: Boolean;
    FEvaluationErrorMessage: String;
    FCorrectAnswerShown: Boolean;
    FCanResetAnswer: Boolean;
    procedure AnswerChange(Sender: TObject);
    procedure Evaluate;
    function QuestionScreen: IQuestionScreen;
    procedure DisplayQuestion(IssuedQuestion: TQuestion);
    procedure ProduceQuestion;
    procedure IssueQuestion;
    procedure ReleaseScreen;
    { private declarations }
  public
    procedure AfterConstruction; override;
    destructor Destroy; override;
    function UpToDate: Boolean;
    function CanShowCorrectAnswer: Boolean;
    procedure ShowCorrectAnswer;
    procedure Select;
    function CanResetAnswer: Boolean;
    procedure ResetAnswer;
    function CanRefreshQuestion: Boolean;
    procedure RefreshQuestion;
    function IsEmpty: Boolean;

    property EvaluationErrorMessage: String read FEvaluationErrorMessage;
    property EvaluationFailed: Boolean read FEvaluationFailed;
    property OnEvaluateAnswer: TNotifyEvent read FOnEvaluateAnswer write FOnEvaluateAnswer;
    property PartRight: Single read FPartRight;
    property Version: Int64 read FVersion;
    { public declarations }
  end;

implementation

{$R *.lfm}

type
  TQuestionReader = class
  private
    FTarget: TSection;
    procedure Read(Root: TXmlElement; Parser: TTestParser);
  public
    constructor Create(Target: TSection);
  end;

{ TQuestionReader }

procedure TQuestionReader.Read(Root: TXmlElement; Parser: TTestParser);
var
  i: Integer;
  c: TXmlElement;
begin
  Assert( FTarget.QuestionCount = 0 );

  Parser.DoQuestion(Root.FindElement(ELEM_QUESTION), FTarget);

  for i := 0 to Root.ElementCount-1 do
  begin
    c := Root.Elements[i];
    if SameText(c.Name, ELEM_MODIFIERS) then
      Parser.DoModifiers(c, FTarget.Questions[0].Modifiers);
  end;
end;

constructor TQuestionReader.Create(Target: TSection);
begin
  inherited Create;
  FTarget := Target;
end;

{ TQuestionViewerFrame }

procedure TQuestionViewerFrame.AnswerChange(Sender: TObject);
begin
  FCorrectAnswerShown := FALSE;
  FCanResetAnswer := TRUE;

  Evaluate;
end;

procedure TQuestionViewerFrame.Evaluate;
begin
  try
    FPartRight := FProducedQuestion.Evaluate(QuestionScreen.GetQuestion.Response);
    FEvaluationFailed := FALSE;
    FEvaluationErrorMessage := '';
  except on E: Exception do
    begin
      FPartRight := 0;
      FEvaluationFailed := TRUE;
      FEvaluationErrorMessage := E.Message;
    end;
  end;
  if Assigned(FOnEvaluateAnswer) then
    FOnEvaluateAnswer(Self);
end;

function TQuestionViewerFrame.QuestionScreen: IQuestionScreen;
begin
  Result := FScreen as IQuestionScreen;
end;

procedure TQuestionViewerFrame.DisplayQuestion(IssuedQuestion: TQuestion);
begin
  LockRedraw(Self);
  try
    DeselectChildren(Self);
    ReleaseScreen;

    FScreen := QuestionScreenRegistry.Find(
      TQuestionClass(IssuedQuestion.ClassType)).Create(nil);
    FScreen.Align := alClient;
    FScreen.Parent := Self;
    QuestionScreen.SetUp(IssuedQuestion);

    Evaluate;
    QuestionScreen.GetQuestion.Response.OnChange := AnswerChange;
  finally
    UnlockRedraw(Self);
  end;
end;

procedure TQuestionViewerFrame.IssueQuestion;
var
  IssuedQuestion: TQuestion;
begin
  IssuedQuestion := FProducedQuestion.Clone;
  try
    IssuedQuestion.Filter;
    DisplayQuestion(IssuedQuestion);
  finally
    IssuedQuestion.Free;
  end;

  FCanResetAnswer := FALSE;
  FCorrectAnswerShown := FALSE;
end;

procedure TQuestionViewerFrame.ReleaseScreen;
begin
  if FScreen <> nil then
  begin
    FScreen.Parent := nil;
    Application.ReleaseComponent(FScreen);
    FScreen := nil;
  end;
end;

procedure TQuestionViewerFrame.AfterConstruction;
var
  Input: TStream;
  Section: TSection;
  Reader: TQuestionReader;
begin
  inherited;
  FVersion := Shape.I['version'];
  if Shape['itStream'] <> nil then
  begin
    Input := TStringStream.Create(DecodeStringBase64(Shape.S['itStream']));
    try
      Section := TSection.Create;
      try
        Reader := TQuestionReader.Create(Section);
        try
          ImportFragmentFromItStream(Input, Reader.Read);
          FSourceQuestion := Section.ExtractQuestion(0);
        finally
          Reader.Free;
        end;
      finally
        Section.Free;
      end;
    finally
      Input.Free;
    end;

    ProduceQuestion;
  end;
end;

destructor TQuestionViewerFrame.Destroy;
begin
  FreeAndNil(FScreen);
  FreeAndNil(FProducedQuestion);
  FreeAndNil(FSourceQuestion);
  inherited;
end;

function TQuestionViewerFrame.UpToDate: Boolean;
begin
  UpdateShape;
  Result := Shape.I['version'] = FVersion;
end;

function TQuestionViewerFrame.CanShowCorrectAnswer: Boolean;
begin
  Result := (FScreen <> nil) and not FCorrectAnswerShown;
end;

procedure TQuestionViewerFrame.ShowCorrectAnswer;
var
  q: TQuestion;
begin
  q := QuestionScreen.GetQuestion.Clone;
  try
    q.Response.Assign(FProducedQuestion.Response);
    DisplayQuestion(q);
  finally
    q.Free;
  end;
  Select;

  FCanResetAnswer := TRUE;
  FCorrectAnswerShown := TRUE;
end;

procedure TQuestionViewerFrame.Select;
begin
  if FScreen <> nil then
    SelectFirstChild(FScreen);
end;

function TQuestionViewerFrame.CanResetAnswer: Boolean;
begin
  Result := (FScreen <> nil) and FCanResetAnswer;
end;

procedure TQuestionViewerFrame.ResetAnswer;
begin
  IssueQuestion;
  Select;
end;

function TQuestionViewerFrame.CanRefreshQuestion: Boolean;
begin
  Result := FSourceQuestion <> nil;
end;

procedure TQuestionViewerFrame.RefreshQuestion;
begin
  Dispatcher.PerformAction(Id, 'refresh');
end;

procedure TQuestionViewerFrame.ProduceQuestion;
var
  Alterants: TAlterantList;
begin
  FreeAndNil(FProducedQuestion);
  try
    Alterants := TAlterantList.Create;
    try
      FProducedQuestion := FSourceQuestion.Produce(Alterants);
    finally
      Alterants.Free;
    end;
    IssueQuestion;
  except on E: Exception do
    begin
      ReleaseScreen;
      FreeAndNil(FProducedQuestion);
      lblError.Caption := E.Message;
      lblError.Visible := TRUE;
    end;
  end;
end;

function TQuestionViewerFrame.IsEmpty: Boolean;
begin
  Result := FProducedQuestion = nil;
end;

end.

